# jm_functions.pl
use strict;
use warnings;


use Encode;
use HTML::Entities();
use URI::Escape;

# Porter stemming
use Text::English;

# Named Entity Recognition
use Lingua::EN::NamedEntity;


require 'csv.pl';
require 'jsonpath.pl';


my $FALSE = 0;
my $TRUE  = 1;



#
# Logical functions
#

sub function_jm_if {
    #
    # if then else
    #
    my ($arg1, $arg2, $arg3) = @_;
    return (defined $arg1 && $arg1) ? $arg2 : $arg3;
}

sub function_jm_eq {
    #
    # string equality
    #
    my ($arg1, $arg2) = @_;
    if (!defined $arg1 || !defined $arg2) {
        return $FALSE;
    }
    return ($arg1 eq $arg2) ? $TRUE : $FALSE;
}

sub function_jm_ne {
    #
    # string inequality
    #
    my ($arg1, $arg2) = @_;
    if (!defined $arg1 || !defined $arg2) {
        return $FALSE;
    }
    return ($arg1 ne $arg2) ? $TRUE : $FALSE;
}

sub function_jm_not {
    #
    # !$arg1
    #
    my ($arg1) = @_;
    if (!defined $arg1) {
        return $TRUE;
    }
    return ($arg1) ? $FALSE : $TRUE;
}

sub function_jm_gt {
    #
    # $arg1 > $arg2
    #
    my ($arg1, $arg2) = @_;
    if (!defined $arg1 || !defined $arg2) {
        return $FALSE;
    }
    return ($arg1 > $arg2) ? $TRUE : $FALSE;
}

sub function_jm_lt {
    #
    # $arg1 < $arg2
    #
    my ($arg1, $arg2) = @_;
    if (!defined $arg1 || !defined $arg2) {
        return $FALSE;
    }
    return ($arg1 < $arg2) ? $TRUE : $FALSE;
}

#
# functions on STRING
#

sub function_jm_concat {
    #
    #   STRING concat(ARRAYREF_STRING $text[, $options])
    #
    #   Options:
    #       separator:       STRING  connecting string. Default = '' (i.e. no separator)
    #
    my ($array_ref, $options) = @_;
    if (!defined $array_ref || ref($array_ref) ne 'ARRAY') {
        return '';
    }
    $options = $options || {};
    my $separator = $options->{'separator'} || '';
    return join($separator, @$array_ref);
}

sub function_jm_length {
    #
    #   STRING length(STRING $text)
    #
    return length(shift);
}

sub function_jm_downcase {
    #
    #   STRING downcase(STRING $text)
    #
    return lc(shift);
}

sub function_jm_upcase {
    #
    #   STRING upcase(STRING $text)
    #
    return uc(shift);
}

sub function_jm_latinise {
    #
    #   STRING latinise(STRING $text)
    #
    my ($str) = @_;
    return util_replaceDiacritics($str);
}

sub function_jm_strip {
    #
    #   STRING strip(STRING $text[, $options])
    #
    #   Strip specified characters from string (default, removes all non-whitespace and non-letters)
    #
    #   Options:
    #       regex:              STRING  Perl regular expression. Default = [^\p{Letter}\p{Number}_\s]
    #
    my ($text, $options) = @_;
    if (!defined $text) {
        return '';
    }
    $options = $options || {};

    if (defined $options->{'regex'}) {
        if ($options->{'regex'} =~ m/\(\s*\?\s*\{/xsm) {
            warn_message('unsafe regex in strip: \'',$options->{'regex'},'\'');
            return $text;
        }
        $text =~ s/$options->{'regex'}//gxsm;
    }
    else {
        $text =~ s/[^\p{Letter}\p{Number}_\s]//gxmso;
    }
    return $text;
}

sub function_jm_normalise_whitespace {
    #
    #   STRING normalise_whitespace(STRING $str)
    #
    #   Replace whitespace sequences by a single space
    #
    my ($str) = @_;
    $str =~ s/\s+/\ /gxsm;
    return $str;
}

sub function_jm_remove_html {
    #
    #   STRING remove_html(STRING $str)
    #
    #   Nieve implementation of xml/html tag removal (+ removes xml/html comments)
    #   FIXME: ought to use a parser to do this!
    #
    my ($str) = @_;
    # remove comments
    $str =~ s/<!--.+?-->//gxsmo;
    # remove elements
    $str =~ s/<[^>]+>/\ /gxsmo;
    # unescape
$str = Encode::decode('Detect', HTML::Entities::decode_entities($str) );
#    $str = HTML::Entities::decode_entities($str);
#            my $str2 = '';
#            try {
#                $str2 = Encode::decode('Detect', $str);
#            } catch {
#                print STDERR "\n-------- ERROR: ". $_;
#            };
    return $str;
}

sub function_jm_http_get {
    #
    #   STRING http_get(STRING $url[, HASH_REF $options])
    #
    #   url may contain query string
    #   Options:
    #    params => HASHREF,     parameter key=>value pairs
    #    headers => HASHREF,    header key=>value pairs
    #
    my ($url, $options) = @_;
    $options = ((defined $options && ref($options) eq 'HASH') ? $options : {});
#FIXME: workaround for 'No such file or directory' error (no idea why get these)
local $!;
    my $res = http_get(
        'url'       =>  $url,
        'params'    =>  $options->{'params'},
        'headers'   =>  $options->{'headers'}
    );
    return $res->{'content'};
}

sub function_jm_http_post {
    #
    #   STRING http_post(STRING $url[, HASH_REF $options])
    #
    #   url may contain query string (will be converted to post params before sending)
    #   Options:
    #    params => HASHREF,     parameter key=>value pairs
    #    headers => HASHREF,    header key=>value pairs
    #
    my ($url, $options) = @_;
    $options = ((defined $options && ref($options) eq 'HASH') ? $options : {});
#FIXME: workaround for 'No such file or directory' error (no idea why get these)
local $!;
    my $res = http_post(
        'url'       =>  $url,
        'params'    =>  $options->{'params'},
        'headers'   =>  $options->{'headers'}
    );
    return $res->{'content'};
}

sub function_jm_register {
    #
    #   register(STRING $name, STRING $method, STRING $url[, $options])
    #
    #       name        function name (e.g. "yahoopipes:filter_by_date")
    #       method      "get"|"post"
    #       url         e.g. "http://subsift.ilrt.bris.ac.uk/test/authors"
    #       options     hash of options to fn_http_post/get, e.g. {params=>{item_id=>'a101',value='blah'},headers=>{token=>'foo'}}
    #                   (these are defaults and may be overridden by individual rpc calls)
    #
    my ($name, $method, $url, $options) = @_;
    my $rpc = get_rpc() || {};
    $rpc->{$name} = {
        'method'    =>  (lc($method) eq 'post' ? 'post' : 'get'),
        'url'       =>  $url,
        'options'   =>  (($options && ref($options) eq 'HASH') ? $options : {}),
    };
    set_rpc($rpc);
}

sub function_jm_rpc {
    #
    #   rpc(STRING $name, HASH_REF $options)
    #
    #   Remote procedure call to a REST function declared by register() above.
    #   (merges params and headers hashes from $options with registered defaults)
    #
    my ($name, $options) = @_;
    my $rpc = get_rpc() || {};
    if (!exists $rpc->{$name}) {
        return '';
    }
    my $rpc_rec = $rpc->{$name};
    $options = ((defined $options && ref($options) eq 'HASH') ? $options : {});
    # merge default params into params
    if (exists $rpc_rec->{'options'}{'params'}) {
        if (!exists $options->{'params'}) {
            $options->{'params'} = {};
        }
        my $params = $options->{'params'};
        my $defaults = $rpc_rec->{'options'}{'params'};
        for my $key (keys %{$defaults}) {
            if (!exists $params->{$key}) {
                $params->{$key} = $defaults->{$key};
            }
        }
    }
    # merge default headers into headers
    if (exists $rpc_rec->{'options'}{'headers'}) {
        if (!exists $options->{'headers'}) {
            $options->{'headers'} = {};
        }
        my $headers = $options->{'headers'};
        my $defaults = $rpc_rec->{'options'}{'headers'};
        for my $key (keys %{$defaults}) {
            if (!exists $headers->{$key}) {
                $headers->{$key} = $defaults->{$key};
            }
        }
    }
    return (($rpc_rec->{'method'} eq 'post')
        ?   function_jm_http_post($rpc_rec->{'url'}, $options) 
        :   function_jm_http_get($rpc_rec->{'url'}, $options)
    );
}

sub function_jm_time {
    #
    #   DOUBLE time()
    #
    #   Floating seconds since Epoch (using millisecond accurate timer)
    #
    return [Time::HiRes::gettimeofday];
}

sub function_jm_interval {
    #
    #   DOUBLE interval(DOUBLE $t0[, DOUBLE $t1])
    #
    #   Different between t0 and t1. 
    #   If t0 omitted then transformation run start time used.
    #   If t1 omitted then current time is used.
    #
    my ($t0, $t1) = @_;
    if (!defined $t0) {
        $t0 = get_timestamp();
    }
    if (!defined $t1) {
        $t1 = [Time::HiRes::gettimeofday];
    }
    return Time::HiRes::tv_interval($t0, $t1);
}

sub function_jm_timestamp {
    #
    #   DOUBLE timestamp()
    #
    #   Return floating seconds since Epoch at the time transformation started.
    #
    return get_timestamp();
}


sub function_jm_named_entities {
    #
    #   ARRAY_REF named_entities(STRING $str)
    #
    #   Return list of entities extracted from $str
    #
    my ($str) = @_;
    my @entities = extract_entities($str);
return \@entities;
    my @words = ();
    for my $entity (@entities) {
        #FIXME: just taking top ranking match, but could do something smarter with confidence scores (we are ignoring them for now)
=head
$VAR1 = {
          'scores' => {
                        'organisation' => 3,
                        'person' => 4,
                        'place' => 1
                      },
          'count' => 1,
          'entity' => 'Red Guards',
          'class' => 'person'
        };
$VAR2 = {
          'scores' => {
                        'organisation' => 4,
                        'person' => 1,
                        'place' => 1
                      },
          'count' => 1,
          'entity' => 'Old Photographs Fever',
          'class' => 'organisation'
        };
=cut


    }
    return \@words;
}

sub function_jm_to_words {
    error_message('FN to_words RENAMED split');
    return ["FN to_words RENAMED split",];
}
sub function_jm_split {
    #
    #   ARRAY_REF split(STRING $str[, HASHREF $options])
    #
    #   split string into an array of words
    #
    #   Options:
    #       minimum_length:     INT     filter out all words shorter than this. Default = 1
    #       maximum_length:     INT     filter out all words longer than this. Default = 100
    #       regex:              STRING  Perl regular expression. Default = [^\p{Letter}\p{Number}_]+
    #
    my ($text, $options) = @_;
    if (!defined $text) {
        return [];
    }
    $options = $options || {};
    my $min_length = !defined $options->{'minimum_length'} ? 1 : 0 + $options->{'minimum_length'};
    my $max_length = !defined $options->{'maximum_length'} ? 100 : 0 + $options->{'maximum_length'};

    my @words;
    if (defined $options->{'regex'}) {
        if ($options->{'regex'} =~ m/\(\s*\?\s*\{/xsm) {
            warn_message('unsafe regex in split: \'',$options->{'regex'},'\'');
            return [];
        }
        @words = split( /$options->{'regex'}/xsm, $text );
    }
    else {
        @words = split( /[^\p{Letter}\p{Number}_]+/o, $text );
    }
    my @filtered_words = ();
    for my $word (@words) {
        my $len = length($word);
        if ($len >= $min_length && $len <= $max_length) {
            push(@filtered_words, $word );
        }
    }
    return \@filtered_words;
}

sub function_jm_extract {
    #
    #   STRING extract(STRING $str[, HASHREF $options])
    #
    #   Extract first captured match from $str using regex in options
    #
    #   Options:
    #       regex:              STRING  Perl regular expression. Default = ([\p{Letter}\p{Number}_]+)
    #
    my ($str, $options) = @_;

    $options = $options || {};

    my $ret = '';
    if (!defined $str) {
        return $ret;
    }

    if (defined $options->{'regex'}) {
        if ($options->{'regex'} =~ m/\(\s*\?\s*\{/xsm) {
            warn_message('unsafe regex in split: \'',$options->{'regex'},'\'');
            return $ret;
        }
        ($ret) = ($str =~ m/$options->{'regex'}/xsm);
    }
    else {
        ($ret) = ($str =~ m/([\p{Letter}\p{Number}_]+)/o);
    }
    return ((defined $ret) ? $ret : '');
}

#
# functions on ARRAYS
#

sub function_jm_push {
    #
    #   ARRAY_REF push(VARIABLE $elem, ARRAY_REF $list)
    #
    my ($elem, $list) = @_;
    if (!defined $list) {
        return [$elem];
    }
    if (ref($list) ne 'ARRAY') {
        return [$elem,$list];
    }
    push(@$list, $elem);
    return $list;
}

sub function_jm_append {
    #
    #   ARRAY_REF append(ARRAY_REF $list1, ARRAY_REF $list2)
    #
    my ($list1, $list2) = @_;
    if (!defined $list1) {
        $list1 = [];
    }
    if (!defined $list2) {
        $list2 = [];
    }
    if (ref($list1) ne 'ARRAY') {
        $list1 = [$list1];
    }
    if (ref($list2) ne 'ARRAY') {
        $list2 = [$list2];
    }
    push(@$list1, @$list2);
    return $list1;
}

sub function_jm_size {
    #
    #   INT size(ARRAY_REF $array)
    #
    my ($array) = @_;
    if (!defined $array || ref($array) ne 'ARRAY') {
        return 0;
    }
    return scalar(@$array);
}

sub function_jm_sort {
    #
    #   ARRAY_REF sort(ARRAY_REF $array[, HASH_REF $options])
    #
    #   Options:
    #       index:      column index to use in sort compare (default 1 for array of arrays; ignored otherwise)
    #       numeric:    0=FALSE|1=TRUE, whether to use numeric compare (default infers from column value on first row)
    #       ascending:  0=FALSE|1=TRUE, sort direction (default 0 for numerics or 1 for non-numerics)
    #
    my ($array, $options) = @_;

    if (!defined $array || 
         ref($array) ne 'ARRAY' || scalar(@$array) == 0) {
        return [];
    }
    my $array_of_arrays = (ref($array->[0]) ne 'ARRAY' || scalar(@{$array->[0]}) == 0) ? $FALSE : $TRUE;

    $options = $options || {};
    my $index = $options->{'index'} || 1;
    my $numeric = (defined $options->{'numeric'} && "$options->{'numeric'}" eq '0') ? $FALSE : $TRUE;
    #FIXME: the following safeguard may be a waste of time if speed is critical (we could just wrap sort in eval and catch the "not a number" error of a duff sort)
    my $sample_value = ($array_of_arrays) ? $array->[0][$index] : $array->[0];
    if ($numeric && $sample_value !~ /^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:e[+-]\d+)?$/) {
        # ignore numeric flag if column contains non-numeric data
        $numeric = $FALSE;
    }

    my @sorted_array;
    if ($numeric) {
        my $ascending = (defined $options->{'ascending'} && "$options->{'ascending'}" eq '1') ? $TRUE : $FALSE;
        if ($ascending) {
            if ($array_of_arrays) {
                @sorted_array = sort { $a->[$index] <=> $b->[$index] } @$array;
            } 
            else {
                @sorted_array = sort { $a <=> $b } @$array;
            }
        }
        else {
            if ($array_of_arrays) {
                @sorted_array = sort { $b->[$index] <=> $a->[$index] } @$array;
            } 
            else {
                @sorted_array = sort { $b <=> $a } @$array;
            }
        }
    }
    else {
        my $ascending = (defined $options->{'ascending'} && "$options->{'ascending'}" eq '0') ? $FALSE : $TRUE;
        if ($ascending) {
            if ($array_of_arrays) {
                @sorted_array = sort { $a->[$index] cmp $b->[$index] } @$array;
            } 
            else {
                @sorted_array = sort { $a cmp $b } @$array;
            }
        }
        else {
            if ($array_of_arrays) {
                @sorted_array = sort { $b->[$index] cmp $a->[$index] } @$array;
            } 
            else {
                @sorted_array = sort { $b cmp $a } @$array;
            }
        }
    }
    return \@sorted_array;
}

sub function_jm_limit {
    #
    #   ARRAY_REF limit(ARRAY_REF $array[, HASH_REF $options])
    #
    #   Options:
    #       limit:      only keep first $limit items (default=10)
    #
    my ($array_ref, $options) = @_;

    $options = $options || {};
    my $limit = $options->{'limit'} || 10;

    if ($limit >= scalar(@$array_ref)) {
        return $array_ref;
    }
    my @array = @$array_ref[0..$limit-1];
    return \@array;
}

#
# functions on ARRAYS OF WORDS
#

sub function_jm_min_length {
    #
    #   ARRAY_REF min_length(ARRAY_REF $words, INT $length)
    #
    #   filter out words shorten than $length
    #
    my ($words, $length) = @_;
    if (!defined $length) { 
        $length = 1;
    }
    my @filtered_words = ();
    for my $word (@$words) {
        if (length($word) >= $length) {
            push(@filtered_words, $word);
        }
    }
    return \@filtered_words;
}

sub function_jm_replace_words {
    #
    #   ARRAY_REF replace_words(ARRAY_REF $words[, HASH_REF $options])
    #
    #   Replace each word that occurs as a key in 'replace' key=>value hash with value
    #
    #   Options:
    #       replace:     HASH_REF   {old_word=>new_word,...} Substitute old_word for new_word. Default = {}
    #       ignore_case: BOOL       0=FALSE|1=TRUE Whether to treat uppercase and lowercase letters as the same. Default=1
    #
    my ($words_ref, $options) = @_;

    $options = $options || {};
    my $match_words = (defined $options->{'replace'} && ref($options->{'replace'}) eq 'HASH')
        ? $options->{'replace'}
        : {};
    if (scalar keys %$match_words == 0) {
        return $words_ref;
    }
    my $ignore_case = (defined $options->{'ignore_case'} && "$options->{'ignore_case'}" eq '0') ? $FALSE : $TRUE;

    my @words = ();
    if ($ignore_case) {
        foreach my $word (@$words_ref) {
            my $lcword = lc($word);
            push(@words, (exists $match_words->{$lcword} ? $match_words->{$lcword} : $word));
        }
    }
    else {
        foreach my $word (@$words_ref) {
            push(@words, (exists $match_words->{$word} ? $match_words->{$word} : $word));
        }
    }
    return \@words;
}

sub function_jm_exclude_words {
    #
    #   ARRAY_REF exclude_words(ARRAY_REF $words[, HASH_REF $options])
    #
    #   filter out excluded words from a list of words
    #
    #   Options:
    #       exclude:     HASH_REF   {word=>1,...} Exclude these words. Default = common English stopwords
    #       ignore_case: BOOL       0=FALSE|1=TRUE Whether to treat uppercase and lowercase letters as the same. Default=1
    #
    my ($words_ref, $options) = @_;

    $options = $options || {};
    my $unwanted_words = (defined $options->{'exclude'} && ref($options->{'exclude'}) eq 'HASH')
        ? $options->{'exclude'}
        : function_jm_stopwords();
    my $ignore_case = (defined $options->{'ignore_case'} && "$options->{'ignore_case'}" eq '0') ? $FALSE : $TRUE;

    my @words;
    if ($ignore_case) {
        @words = grep { !$unwanted_words->{lc($_)} } @$words_ref;
    }
    else {
        @words = grep { !$unwanted_words->{$_} } @$words_ref;
    }
    return \@words;
}

sub function_jm_include_words {
    #
    #   ARRAY_REF include_words(ARRAY_REF $words[, HASH_REF $options])
    #
    #   filter out words not in a list of wanted words from a list of words
    #   Special case for empty $wanted_words returns $words unchanged
    #
    #   Options:
    #       include:     HASH_REF   {word=>1,...} Include these words. Default = {} i.e. include everything
    #       ignore_case: BOOL       0=FALSE|1=TRUE Whether to treat uppercase and lowercase letters as the same. Default=1
    #
    my ($words_ref, $options) = @_;

    $options = $options || {};
    my $wanted_words = (defined $options->{'include'} && ref($options->{'include'}) eq 'HASH')
        ? $options->{'include'}
        : {};
    if (scalar keys %$wanted_words == 0) {
        return $words_ref;
    }
    my $ignore_case = (defined $options->{'ignore_case'} && "$options->{'ignore_case'}" eq '0') ? $FALSE : $TRUE;

    my @words;
    if ($ignore_case) {
        @words = grep { $wanted_words->{lc($_)} } @$words_ref;
    }
    else {
        @words = grep { $wanted_words->{$_} } @$words_ref;
    }
    return \@words;
}

sub function_jm_stopwords {
    return {'a'=>1, 'about'=>1, 'above'=>1, 'across'=>1, 'after'=>1, 'afterwards'=>1, 'again'=>1, 'against'=>1, 'all'=>1, 'almost'=>1, 'alone'=>1, 'along'=>1, 'already'=>1, 'also'=>1, 'although'=>1, 'always'=>1, 'am'=>1, 'among'=>1, 'amongst'=>1, 'amount'=>1, 'an'=>1, 'and'=>1, 'another'=>1, 'any'=>1, 'anyhow'=>1, 'anyone'=>1, 'anything'=>1, 'anyway'=>1, 'anywhere'=>1, 'are'=>1, 'around'=>1, 'as'=>1, 'at'=>1, 'back'=>1, 'be'=>1, 'became'=>1, 'because'=>1, 'become'=>1, 'becomes'=>1, 'becoming'=>1, 'been'=>1, 'before'=>1, 'beforehand'=>1, 'behind'=>1, 'being'=>1, 'below'=>1, 'beside'=>1, 'besides'=>1, 'between'=>1, 'beyond'=>1, 'bill'=>1, 'both'=>1, 'bottom'=>1, 'but'=>1, 'by'=>1, 'call'=>1, 'can'=>1, 'cannot'=>1, 'cant'=>1, 'co'=>1, 'computer'=>1, 'con'=>1, 'could'=>1, 'couldnt'=>1, 'cry'=>1, 'de'=>1, 'describe'=>1, 'detail'=>1, 'do'=>1, 'done'=>1, 'down'=>1, 'due'=>1, 'during'=>1, 'each'=>1, 'eg'=>1, 'eight'=>1, 'either'=>1, 'eleven'=>1, 'else'=>1, 'elsewhere'=>1, 'empty'=>1, 'enough'=>1, 'etc'=>1, 'even'=>1, 'ever'=>1, 'every'=>1, 'everyone'=>1, 'everything'=>1, 'everywhere'=>1, 'except'=>1, 'few'=>1, 'fifteen'=>1, 'fifty'=>1, 'fill'=>1, 'find'=>1, 'fire'=>1, 'first'=>1, 'five'=>1, 'for'=>1, 'former'=>1, 'formerly'=>1, 'forty'=>1, 'found'=>1, 'four'=>1, 'from'=>1, 'front'=>1, 'full'=>1, 'further'=>1, 'get'=>1, 'give'=>1, 'go'=>1, 'had'=>1, 'has'=>1, 'hasnt'=>1, 'have'=>1, 'he'=>1, 'hence'=>1, 'her'=>1, 'here'=>1, 'hereafter'=>1, 'hereby'=>1, 'herein'=>1, 'hereupon'=>1, 'hers'=>1, 'herself'=>1, 'him'=>1, 'himself'=>1, 'his'=>1, 'how'=>1, 'however'=>1, 'hundred'=>1, 'i'=>1, 'ie'=>1, 'if'=>1, 'in'=>1, 'inc'=>1, 'indeed'=>1, 'interest'=>1, 'into'=>1, 'is'=>1, 'it'=>1, 'its'=>1, 'itself'=>1, 'keep'=>1, 'last'=>1, 'latter'=>1, 'latterly'=>1, 'least'=>1, 'less'=>1, 'ltd'=>1, 'made'=>1, 'many'=>1, 'may'=>1, 'me'=>1, 'meanwhile'=>1, 'might'=>1, 'mill'=>1, 'mine'=>1, 'more'=>1, 'moreover'=>1, 'most'=>1, 'mostly'=>1, 'move'=>1, 'much'=>1, 'must'=>1, 'my'=>1, 'myself'=>1, 'name'=>1, 'namely'=>1, 'neither'=>1, 'never'=>1, 'nevertheless'=>1, 'next'=>1, 'nine'=>1, 'no'=>1, 'nobody'=>1, 'none'=>1, 'noone'=>1, 'nor'=>1, 'not'=>1, 'nothing'=>1, 'now'=>1, 'nowhere'=>1, 'of'=>1, 'off'=>1, 'often'=>1, 'on'=>1, 'once'=>1, 'one'=>1, 'only'=>1, 'onto'=>1, 'or'=>1, 'other'=>1, 'others'=>1, 'otherwise'=>1, 'our'=>1, 'ours'=>1, 'ourselves'=>1, 'out'=>1, 'over'=>1, 'own'=>1, 'part'=>1, 'per'=>1, 'perhaps'=>1, 'please'=>1, 'put'=>1, 'rather'=>1, 're'=>1, 'same'=>1, 'see'=>1, 'seem'=>1, 'seemed'=>1, 'seeming'=>1, 'seems'=>1, 'serious'=>1, 'several'=>1, 'she'=>1, 'should'=>1, 'show'=>1, 'side'=>1, 'since'=>1, 'sincere'=>1, 'six'=>1, 'sixty'=>1, 'so'=>1, 'some'=>1, 'somehow'=>1, 'someone'=>1, 'something'=>1, 'sometime'=>1, 'sometimes'=>1, 'somewhere'=>1, 'still'=>1, 'such'=>1, 'system'=>1, 'take'=>1, 'ten'=>1, 'than'=>1, 'that'=>1, 'the'=>1, 'their'=>1, 'them'=>1, 'themselves'=>1, 'then'=>1, 'thence'=>1, 'there'=>1, 'thereafter'=>1, 'thereby'=>1, 'therefore'=>1, 'therein'=>1, 'thereupon'=>1, 'these'=>1, 'they'=>1, 'thick'=>1, 'thin'=>1, 'third'=>1, 'this'=>1, 'those'=>1, 'though'=>1, 'three'=>1, 'through'=>1, 'throughout'=>1, 'thru'=>1, 'thus'=>1, 'to'=>1, 'together'=>1, 'too'=>1, 'top'=>1, 'toward'=>1, 'towards'=>1, 'twelve'=>1, 'twenty'=>1, 'two'=>1, 'un'=>1, 'under'=>1, 'until'=>1, 'up'=>1, 'upon'=>1, 'us'=>1, 'very'=>1, 'via'=>1, 'was'=>1, 'we'=>1, 'well'=>1, 'were'=>1, 'what'=>1, 'whatever'=>1, 'when'=>1, 'whence'=>1, 'whenever'=>1, 'where'=>1, 'whereafter'=>1, 'whereas'=>1, 'whereby'=>1, 'wherein'=>1, 'whereupon'=>1, 'wherever'=>1, 'whether'=>1, 'which'=>1, 'while'=>1, 'whilst'=>1, 'whither'=>1, 'who'=>1, 'whoever'=>1, 'whole'=>1, 'whom'=>1, 'whose'=>1, 'why'=>1, 'will'=>1, 'with'=>1, 'within'=>1, 'without'=>1, 'would'=>1, 'yet'=>1, 'you'=>1, 'your'=>1, 'yours'=>1, 'yourself'=>1, 'yourselves'=>1 };
}

sub function_jm_stem {
    #
    #   ARRAY_REF stem(ARRAY_REF $words)
    #
    #   apply Porter Stemming to a list of words
    #
    my ($words) = @_;
    my @words = Text::English::stem( @$words );
    return \@words;
}

sub function_jm_prefixes {
    #
    #   HASH_REF prefixes(ARRAY_REF $words[, HASH_REF $options])
    #
    #   count occurrences of each unique left substring in a list of words
    #
    #   Options:
    #       none yet
    #
    my ($words, $options) = @_;

    my %prefixes = ();
    foreach my $word (@$words) {
        my $wordlen = length($word);
        for(my $i=1; $i <= $wordlen; $i++) {
            my $prefix = substr($word, 0, $i);
            if (exists $prefixes{$prefix}) {
                $prefixes{$prefix}++;
            }
            else {
                $prefixes{$prefix} = 1;
            }
        }
    }
    return \%prefixes;
}

sub function_jm_pgrams {
    #
    #   HASH_REF pgrams(ARRAY_REF $words[, HASH_REF $options])
    #
    #   count occurrences of each unique p-gram in a list of words (i.e. p-spectrum)
    #
    #   Options:
    #       pvalues:     ARRAY_REF  [INT,...] array of values of p>0 for p-grams. Default = [1,2,3]
    #
    my ($words, $options) = @_;

    $options = $options || {};
    my $pvalues = (defined $options->{'pvalues'} && ref($options->{'pvalues'}) eq 'ARRAY')
        ? $options->{'pvalues'}
        : [1,2,3];

    my %grams = ();
    foreach my $word (@$words) {
        my $wordlen = length($word);
        for my $p (@$pvalues) {
            my $ilim = $wordlen + 1 - $p;
            for(my $i=0; $i < $ilim; $i++) {
                my $pgram = substr($word, $i, $p);
                if (exists $grams{$pgram}) {
                    $grams{$pgram}++;
                }
                else {
                    $grams{$pgram} = 1;
                }
            }
        }
    }
    return \%grams;
}

sub function_jm_ngrams {
    #
    #   ARRAY_REF ngrams(ARRAY_REF $words[, HASH_REF $options])
    #
    #   construct n-grams and append to list of words
    #   for each INT $n in an array of $nvalues
    #
    #   Options:
    #       nvalues:     ARRAY_REF  [INT,...] array of values of n>0 for n-grams. Default = [1,2]
    #
    my ($words, $options) = @_;

    $options = $options || {};
    my $nvalues = (defined $options->{'nvalues'} && ref($options->{'nvalues'}) eq 'ARRAY')
        ? $options->{'nvalues'}
        : [1,2];

    my @grams = ();
    my $noofwords = scalar(@$words);
    for my $n (@$nvalues) {
        if ($n == 1) {
            # no need to construct 1-grams, so just append them
            @grams = (@grams, @$words);
        }
        elsif ($noofwords >= $n) {
            # construct n-grams
            my $nm1 = $n - 1;
            my $ilim = $noofwords - $nm1;
            for (my $i=0; $i < $ilim; $i++) {
                push(@grams, join(' ', @{$words}[$i..$i+$nm1]));
            }
        }
    }
    return \@grams;
}

sub function_jm_count_words {
    print STDERR "DEPRECATED FN: count_words (use multiset instead)";
    function_jm_multiset(@_);
}

sub function_jm_multiset {
    #
    #   HASH_REF multiset(ARRAY_REF $array)
    #
    #   count number of occurrences of each item in array
    #   returns multiset <STRING term, INT count>
    #
    my ($array) = @_;
    if (ref($array) ne 'ARRAY') {
        return {$array => 1};
    }
    my %term_n = ();
    foreach my $term (@$array){
        $term_n{$term}++;
    }
    return \%term_n;
}

sub function_jm_set {
    #
    #   HASH_REF set(ARRAY_REF $array)
    #
    #   record existence of each item in array
    #   returns multiset <STRING term, 1>
    #
    my ($array) = @_;
    if (ref($array) ne 'ARRAY') {
        return {$array => 1};
    }
    my %set = ();
    foreach my $term (@$array){
        if (!exists $set{$term}) {
            $set{$term} = 1;
        }
    }
    return \%set;
}

#sub function_jm_object2 {
#    #
#    #   HASH_REF object(key1,value1, key2,value2, ...)
#    #
#    #   construct a hash from an even number of key-value arguments
#    #
#    my %hash = @_;
#    return \%hash;
#}

sub function_jm_object {
    #
    #   HASH_REF object(ARRAY_REF $hash_data)
    #
    #   construct a hash from an even sized array [key1,value1,key2,value2,...]
    #
    my ($array_ref) = @_;
    my %hash = @$array_ref;
    return \%hash;
}

#sub function_jm_pairs_to_object {
#    #
#    #   HASH_REF pairs_to_object(ARRAY_REF [$pair])
#    #
#    #   construct a hash from an array of key-value pairs, [[key1,value1],[key2,value2],...]
#    #
#    my ($array_ref) = @_;
#    my %hash = ();
#    foreach my $pair (@$array_ref) {
#        $hash{$pair->[0]} = $pair->[1];
#    }
#    return \%hash;
#}


#
# functions on HASH_REF MULTISETS & SETS
#

sub function_jm_object_keys {
    #
    #   ARRAY_REF object_keys(HASH_REF)
    #
    my ($hash) = @_;
    if (!defined $hash || ref($hash) ne 'HASH') {
        return [];
    }
    my @keys = keys %$hash;
    return \@keys;
}

sub function_jm_object_values {
    #
    #   ARRAY_REF object_values(HASH_REF)
    #
    my ($hash) = @_;
    if (!defined $hash || ref($hash) ne 'HASH') {
        return [];
    }
    my @values = values %$hash;
    return \@values;
}

sub function_jm_object_cardinality {
    #
    #   ARRAY_REF object_cardinality(HASH_REF)
    #
    my ($hash) = @_;
    if (!defined $hash || ref($hash) ne 'HASH') {
        return 0;
    }
    return scalar keys %$hash;
}

sub function_jm_set_union {
    #
    #   HASH_REF set_union(HASH_REF $set,...)
    #
    #   merges a list of sets into a single set
    #   returns set <STRING term, BOOL $TRUE>
    #
    # dodgy type wrangling: unwrap a singleton array argument and treat its elements as @_
    # as a convenience to allow json path queries that return multiple results to act as n-ary arguments
    my $arglist = \@_;
    if (scalar(@$arglist) == 1 && ref($arglist->[0]) eq 'ARRAY') {
        $arglist = $arglist->[0];
    }
    # start of sub proper...
    my %hash = ();
    LP_ARGS:
    foreach my $set (@$arglist) {
        # skip null arguments
        if (!defined $set) {
            next LP_ARGS;
        }
        if (ref($set) ne 'HASH') {
            $hash{$set} = 1;
        }
        # merge in hash representation of set
        while( my ($key, $value) = each(%$set) ) {
#$key = Encode::decode('UTF-8', $key);
            if (!exists $hash{$key}) {
                $hash{$key} = 1;
            }
        }
    }
    return \%hash;
}

sub function_jm_object_union {
    #
    #   HASH_REF object_union(HASH_REF $hash,...)
    #
    #   merges a list of hashes into a single hash
    #   returns hash
    #
    # dodgy type wrangling: unwrap a singleton array argument and treat its elements as @_
    # as a convenience to allow json path queries that return multiple results to act as n-ary arguments
    my $arglist = \@_;
    if (scalar(@$arglist) == 1 && ref($arglist->[0]) eq 'ARRAY') {
        $arglist = $arglist->[0];
    }
    # start of sub proper...
    my %hash = ();
    LP_ARGS:
    foreach my $hasharg (@$arglist) {
        # skip null arguments
        if (!defined $hasharg) {
            next LP_ARGS;
        }
        if (ref($hasharg) ne 'HASH') {
            next LP_ARGS;
        }
        # merge in hash representation of hasharg
        while( my ($key, $value) = each(%$hasharg) ) {
#$key = Encode::decode('UTF-8', $key);
            if (exists $hash{$key}) {
                # multiple values on same key, so collect in an array
                if (ref($hash{$key}) ne 'ARRAY') {
                    $hash{$key} = [$hash{$key}, $value];
                }
                else {
                    push(@{$hash{$key}}, $value);
                }
            }
            else {
                $hash{$key} = $value;
            }
        }
    }
    return \%hash;
}

#sub function_jm_multiset_union {
#   for each key, sets multiplicity to max of its value in arg1 or arg2 (see wikipedia)
#}

sub function_jm_multiset_union {
    #
    #   HASH_REF multiset_union($multiset1, $multiset2, ...)
    #
    #   merges a list of multisets into a single multiset (i.e. may change the first arg if it is a multiset)
    #   sums the multiplicities of corresponding keys
    #   returns multiset <STRING term, INT multiplicity>
    #
    #   unpacks any array arguments to lists of key,value, which are processed as a hash
    #   scalars are treated as if a singleton multiset whose key is the scalar and multiplicity is 1
    #
#    my $arglist = \@_;
    my $hash_ref;
    LP_ARGS:
    foreach my $arg (@_) {
#    while(scalar @$arglist) {
#        my $arg = shift @$arglist;
        # skip null arguments
        if (!defined $arg) {
            next LP_ARGS;
        }
        if (!ref($arg)) {
            # treat scalars as a singleton multiset
            $arg = [$arg, 1];
        }
        if (ref($arg) eq 'ARRAY') {
            if (!defined $hash_ref) {
                # create a new hash from first argument
                my %hash = @$arg;
                $hash_ref = \%hash;
            }
            else {
                # merge into destination hash
                while(scalar @$arg) {
                    my $key = shift @$arg;
#$key = Encode::decode('UTF-8', $key);
                    my $value = shift @$arg;
                    if (!exists $hash_ref->{$key}) {
                        $hash_ref->{$key} = $value;
                    }
                    else {
                        $hash_ref->{$key} += $value;
                    }
                }
            }
        }
        elsif (ref($arg) eq 'HASH') {
            if (!defined $hash_ref) {
                # first multiset argument becomes the destination hash
                $hash_ref = $arg;
            }
            else {
                # merge into destination hash
                while( my ($key, $value) = each(%$arg) ) {
#$key = Encode::decode('UTF-8', $key);
                    if (!exists $hash_ref->{$key}) {
                        $hash_ref->{$key} = $value;
                    }
                    else {
                        $hash_ref->{$key} += $value;
                    }
                }
            }
        }
    }
    return $hash_ref || {};
}

sub function_jm_multiset_increment {
    #
    #   HASH_REF multiset_increment(HASH_REF $multiset_count, $multiset1, $multiset2, ...)
    #
    #   increments corresponding $multiset_count term by 1 for each term key in $multiset
    #   returns multiset_count <STRING term, INT count>
    #
    #   unpacks any array arguments to lists of keys, which are processed as if keys of a hash
    #   scalars are treated as if a singleton multiset whose key is the scalar
    #
    my $multiset_count = shift || {};
    LP_ARGS:
    foreach my $arg (@_) {
        # skip null arguments
        if (!defined $arg) {
            next LP_ARGS;
        }
        if (!ref($arg)) {
            # treat scalars as a singleton multiset
            $arg = [$arg,];
        }
        if (ref($arg) eq 'ARRAY') {
            foreach my $key (@$arg) {
#$key = Encode::decode('UTF-8', $key);
                if (!exists $multiset_count->{$key}) {
                    $multiset_count->{$key} = 1;
                }
                else {
                    $multiset_count->{$key}++;
                }
            }
        }
        elsif (ref($arg) eq 'HASH') {
            while( my ($key, $_value) = each(%$arg) ) {
#$key = Encode::decode('UTF-8', $key);
                if (!exists $multiset_count->{$key}) {
                    $multiset_count->{$key} = 1;
                }
                else {
                    $multiset_count->{$key}++;
                }
            }
        }
    }
    return $multiset_count;
}

sub function_jm_multiset_cardinality {
    #
    #   INT multiset_cardinality(HASH_REF $multiset)
    #
    my ($hashref) = @_;
    my $count = 0;
    foreach my $value (values %$hashref) {
        $count += $value;
    }
    return $count;
}

#
# higher order functions
#

sub function_jm_path_index_set {
    #
    #   ARRAY_REF path_index_set(VARIABLE $value[, $options])
    #
    #   returns array of JSONPath expressions indexing sub-terms of variable $value
    #
    my ($value, $options) = @_;
    require 'schema.pl';
    return path_index_set($value, $options);
}

sub function_jm_path_indices {
    #
    #   ARRAY_REF path_indices(VARIABLE $value[, $options])
    #
    #   returns array of JSONPath expressions indexing sub-terms of variable $value
    #
    my ($value, $options) = @_;
    require 'schema1.pl';
    return path_index_set($value, $options);
}

sub function_jm_detect_types {
    #
    #   ARRAY_REF xxxx(VARIABLE $value[, $options])
    #
    #   returns array of JSONPath expressions indexing sub-terms of variable $value
    #
    my ($value, $options) = @_;
    require 'schema2.pl';
    return detect_types($value, $options);
}


#   DEFERRED_ functions control which arguments are evaluated prior to calling.
#   Returns an array of BOOL values, one per arg of the similarly named function_
#   where a 1 means "do not evaluate this arg when calling the function_".
#   The default is 0, which means "evaluate arg before calling the function_".
#   The default means that it is only necessary to create a deferred_ sub if need
#   deferred evaluation of one or more of the associated embedded function_'s args.
#
sub DEFERRED_jm_project { return [1,0]; }
sub function_jm_project {
    #
    #   ARRAY_REF project(JSONPath_REF $path, VARIABLE $value)
    #
    #   returns results of JSONPath expression applied to variable $value
    #
    my ($path, $value) = @_;
    return helper_apply_json_path($path, $value);
}

sub DEFERRED_jm_restrict { return [0,1]; }
sub function_jm_restrict {
    #
    #   ARRAY_REF restrict(ARRAY_REF $values_arrayref, $predicate)
    #
    #   Return copy of array with all elements that do not satisfy $predicate removed.
    #   The value of each element is available in the predicate via the context variable '$.item'.
    #   e.g. To select just elements that have the value "BLUE"
    #          ["jm:restrict", "$item[0].choices", ["jm:eq", "BLUE", "$.item"]]
    #        or select just elements that are arrays where the 3nd element is > 0.95
    #          ["jm:restrict", "$item[0].termstats", ["jm:gt", "$.item[3]", 0.95]]
    #
    my ($values_arrayref, $predicate) = @_;

    my @results = ();
    if (ref($values_arrayref) ne 'ARRAY') {
        return \@results;
    }

    my $local_context = {};
    foreach my $elem (@$values_arrayref) {
        $local_context->{'item'} = $elem;
        my $bool = evaluate_template_value(
            $predicate,
            $local_context
        );
        if ($bool) {
            push(@results, $elem);
        }
    }

    return \@results;
}


sub DEFERRED_jm_apply { return [1,0,0]; }
sub function_jm_apply {
    #
    #   ARRAY_REF apply($JSON $template_item, ARRAY_REF $values_arrayref)
    #
    #   Evaluate template on each element in $values to generate a new array.
    #   The value of each element is available in the template via the context variable '$.item'.
    #   e.g. To convert a space delimited string to an array of word lengths,
    #          ["jm:apply", ["jm:length", "$.item"], ["jm:split", "$.items[0][1]"]]
    #        or a hash of word-length pairs,
    #          ["jm:apply", {"word":"$.item", "len":["jm:length", "$.item"]}, ["jm:split", "$.items[0][1]"]]
    #
    my ($template_item, $values_arrayref) = @_;

    my @results = ();
    if (ref($values_arrayref) ne 'ARRAY') {
        return \@results;
    }

    my $local_context = {};
    foreach my $elem (@$values_arrayref) {
        $local_context->{'item'} = $elem;
        my $result = evaluate_template_value(
            $template_item,
            $local_context
        );
        push(@results, $result);
    }

    return \@results;
}

sub DEFERRED_jm_generate { return [1,0,1]; }
sub function_jm_generate {
    #
    #   void generate($JSON $template_item, ARRAY_REF $values_arrayref[, $options])
    #
    #   Evaluate template on each element in $values to generate an item.
    #   Each item is stored with an automatically generated id unless 'id_path' option is specified.
    #   If 'fetch_item' is true then the previous item value stored against this id is fetched and available in
    #   the context as 'item'. The template is responsible for merging old and new values of the item.
    #
    #   Options:
    #       id_path:      JSONPath_REF  determine id to store generated item as (evaluated on each element in $values)
    #       unique_id:    BOOL          whether to allow update/replacement of already used items. Default = 0
    #       fetch_item:   BOOL          whether to fetch old value of item at this id into context as 'item'. Default 0
    #
    my ($template_item, $values_arrayref, $options) = @_;

    if (ref($values_arrayref) ne 'ARRAY') {
        return;
    }

    $options = $options || {};
    my $id_path = (defined $options->{'id_path'} && ref($options->{'id_path'}) eq 'JSON::Path') 
        ? $options->{'id_path'} 
        : undef;
    my $unique_id = (defined $options->{'unique_id'} && "$options->{'unique_id'}" eq '1') ? $TRUE : $FALSE;
    my $fetch_item = (defined $options->{'fetch_item'} && "$options->{'fetch_item'}" eq '1') ? $TRUE : $FALSE;

    # gather information needed to retrieve old items from database
    my $folder_path;
    {
        my $FOLDER_TYPE = 'relations';
        my $settings = get_settings();
        my $params = get_params();
        $folder_path = File::Spec->catdir(
            $settings->{'USERS_PATH'}, $params->{'user_id'}, $FOLDER_TYPE, $params->{'folder_id'}
        );
        # if first batch of copy/transformations, the destination folder might not yet exist
        if (!-d $folder_path) {
            # flag folder as not existing yet
            $folder_path = undef;
        }
    }

    my $all_results = generate_get();   # get ref to global results hash variable (so we can add in new items)
    my $context = context_get();
    my $original_item    = $context->{'item'};
    my $original_item_id = $context->{'item_id'};
    for my $subvalue (@$values_arrayref) {
        $context->{'item'} = $subvalue;

        # construct an item_id from either the JSONPath path_id or by autogenerating an id
        if (defined $id_path) {
            my $item_id_result = evaluate_template_value(
                $id_path,
                $context
            );
            if (!defined $item_id_result) {
                $item_id_result = 'ID_PATH_RESULT_EMPTY';
            }
            elsif (ref($item_id_result) eq 'ARRAY') {
                $item_id_result = $item_id_result->[0];
            }
            $context->{'item_id'} = util_getValidFileName($item_id_result);
        }
        else {
            $context->{'item_id_i'}++;
            $context->{'item_id'} = sprintf('i%06u', $context->{'item_id_i'});
        }

        # determine if a previously stored item at this id is relevant
        if ($fetch_item) {
            if (exists $all_results->{ $context->{'item_id'} }) {
                $context->{'old_item'} = $all_results->{ $context->{'item_id'} };
            }
            else {
                my $is_output = $FALSE;
                $context->{'old_item'} = (defined $folder_path) 
                    ? helper_items_get2($folder_path, $context->{'item_id'}, $is_output)
                    : undef;
            }
        }
        else {
            $context->{'old_item'} = undef;
        }

        if ($unique_id) {
            my $exists = $FALSE;
            if (defined $context->{'old_item'}) {
                $exists = $TRUE;
            }
            else {
                if (exists $all_results->{ $context->{'item_id'} }) {
                    $exists = $TRUE;
                }
                else {
                    if (defined $folder_path) {
                        $exists = helper_items_exists2($folder_path, [$context->{'item_id'}]);
                    }
                }
            }
            if ($exists) {
                render({
                    'status' => '403 Forbidden',
                    'text'   => serialise_error_message("'unique_id' option set but item already exists: '$context->{'item_id'}'"),
                });
                return;
            }
        }

        my $result = evaluate_template_value(
            $template_item,
            $context
        );

        $all_results->{ $context->{'item_id'} } = $result;
    }
    $context->{'item'}    = $original_item;
    $context->{'item_id'} = $original_item_id;
    delete $context->{'old_item'};
}

#
# stats functions
#

sub function_jm_tfidf {
    #
    #   ARRAY_REF tfidf(
    #       HASH_REF <STRING term => INT n> $term_n,
    #       INT $document_n,
    #       HASH_REF <STRING term => INT dt> $corpus_dt,
    #       INT $noofdocs
    #   )
    #
    #   returns array <STRING key, ARRAY_REF tuple> where tuple is [tfidf, n, tf, idf]
    #
    my ($term_n, $document_n, $corpus_dt, $noofdocs) = @_;

    my $adjusted_noofdocs = ($noofdocs == 1) ? 2 : $noofdocs;
    my $log_2 = log(2.0);

    my @result = ();
    LP:
    while (my ($term, $n) = each(%$term_n)) {

        my $tf = $n / $document_n;
#FIXME: temporarily protect against encoding charset bug until make keys UTF8 (or can get div by 0 below)
if (! exists $corpus_dt->{$term}) {
    print STDERR "-------------> TERM WITHOUT dt for key='$term' \n";
    $term = Encode::encode('UTF-8', $term);
    if (! exists $corpus_dt->{$term}) {
        print STDERR "+++++++++++++++++> FAILED TO FIX TERM WITHOUT dt : '$term' \n";
##        next LP;
##        die;
        $corpus_dt->{$term} = 100000000;
    }
}
        my $idf = log( $adjusted_noofdocs / $corpus_dt->{$term} ) / $log_2;
        my $tfidf = $tf * $idf;
#        my $term_weight_global = $weights_global->{$term}; 
#        if (!defined $term_weight_global) { $term_weight_global = $term_weight_default; }
#        my $term_weight_local  = $weights_local->{$term};
#        if (!defined $term_weight_local) { $term_weight_local = $term_weight_default; }
#        my $weighted_tfidf = $tfidf * $term_weight_global * $term_weight_local;
        push(@result, [ 
#            $weighted_tfidf, 
#            $tfidf, 
            Encode::decode('UTF-8', $term), 
#            [$n, $tf, $idf, $tfidf, $term_weight_global, $term_weight_local, $weighted_tfidf]
            $tfidf, $n, $tf, $idf
        ]);
    }
    return \@result;
}


sub function_jm_cosine {
    #
    #   ARRAY_REF cosine(
    #       ARRAY_REF terms1,
    #       ARRAY_REF terms2
    #   )
    #
    my ($terms1, $terms2) = @_;

    my $lookupterms = (scalar(@$terms1) > scalar(@$terms2)) ? $terms2 : $terms1;
    my $serialterms = (scalar(@$terms1) > scalar(@$terms2)) ? $terms1 : $terms2;

    # convert array to hash keyed on term
    my %keyedterms = ();
    my $norm_a = 0;
    for my $elem (@$lookupterms) {
        $keyedterms{$elem->[0]} = $elem;
        $norm_a += $elem->[2] * $elem->[2];
    }
    $norm_a = sqrt($norm_a);

    my $norm_b = 0;
    for my $elem (@$serialterms) {
        $norm_b += $elem->[2] * $elem->[2];
    }
    $norm_b = sqrt($norm_b);

    # compute dot product of term vectors (iterating over shortest key set)
    my $dotproduct = 0;
    my @shared_terms = ();
    for my $stats (@$serialterms) {
        my $term = $stats->[0];
        if (exists $keyedterms{$term}) {
            my $contribution = $stats->[2] * $keyedterms{$term}[2];
            # ignore terms with non-zero tf but zero tfidf (ie. ones which are significant in a single doc but which occur in all docs)
            if ($contribution > 0) {
                $dotproduct += $contribution;
                push(@shared_terms, [$term, $contribution]);
            }
        }
    }
    my $denom = $norm_a * $norm_b;
    my $cosine = ($denom) ? $dotproduct / $denom : 0;
    if (scalar(@shared_terms) > 1) {
        @shared_terms = sort { $b->[1] <=> $a->[1] } @shared_terms;
    }

    return [$cosine, \@shared_terms];
}

1;
